home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr01 / halcn305.zip / GSOB_NTX.PAS < prev    next >
Pascal/Delphi Source File  |  1993-04-17  |  40KB  |  1,379 lines
  1. unit GSOB_Ntx;
  2. {-----------------------------------------------------------------------------
  3.                            Clipper Index Handler
  4.  
  5.        GS_DBNtx Copyright (c)  Richard F. Griffin
  6.  
  7.        08 February 1993
  8.  
  9.        102 Molded Stone Pl
  10.        Warner Robins, GA  31088
  11.  
  12.        -------------------------------------------------------------
  13.        This unit handles the objects for all Clipper index (.NTX)
  14.        operations.  This unit may be implemented by adding a conditional
  15.        define to the complier options.  In the IDE this is done in the
  16.        Options|Compile menu, selecting Conditional Define, and adding
  17.        CLIPPER as a Define item.  You must then recompile using the
  18.        Compile|Build option to force recompilation of units that will use
  19.        the index.
  20.  
  21.        In the command line compiler use the /D option, for example:
  22.  
  23.                TPC MyProg /DCLIPPER
  24.  
  25.        That's the only change necessary to replace .NDX indexes with
  26.        Clipper .NTX indexes.
  27.  
  28.    Changes:
  29.  
  30.       17 Apr 93 - KeySort routine corrected to handle key string lengths
  31.                   properly in GSOB_NDX.  This correction is included for
  32.                   consistency in the calling structure.  This unit will
  33.                   continue to use Key_Lgth as the string length.
  34.  
  35. ------------------------------------------------------------------------------}
  36. {$O+}
  37.  
  38. interface
  39.  
  40. uses
  41.    GSOB_Var,
  42.    GSOB_Dte,
  43.    GSOB_Str,                          {String handler routines}
  44.    GSOB_Inx,
  45.    GSOB_Dsk,                          {File handler routines}
  46.    GSOB_DBF,
  47.    {$IFDEF WINDOWS}
  48.       Objects;
  49.    {$ELSE}
  50.       GSOB_Obj;
  51.    {$ENDIF}
  52.  
  53. const
  54.  
  55.    NdxBlokSize = 1024;
  56.  
  57.  
  58. type
  59.  
  60.    GSP_InxHeader  = ^GSR_InxHeader;
  61.    GSR_InxHeader  = Record
  62.       Vers1,
  63.       Vers2       : Integer;
  64.       Root        : Longint;
  65.       Unknwn1     : Longint;
  66.       Entry_Sz    : Integer;
  67.       Key_Lgth    : Integer;
  68.       Key_Dcml    : Integer;
  69.       Max_Keys    : Integer;
  70.       Min_Keys    : Integer;
  71.       Key_Form    : array [0..1001] of char;
  72.    end;
  73.  
  74.    GSP_InxDataBlk  = ^GSR_InxDataBlk;
  75.    GSR_InxDataBlk  = Record
  76.       case integer of
  77.          0 : (Data_Ary    : array [0..NdxBlokSize] of byte);
  78.          1 : (Indx_Ary    : array [0..NdxBlokSize div 2] of word);
  79.          2 : (Entry_Ct    : Integer);
  80.    end;
  81.  
  82.    GSP_InxElement = ^GSR_InxElement;
  83.    GSR_InxElement = Record
  84.       Block_Ax  : Longint;
  85.       Recrd_Ax  : Longint;
  86.       Char_Fld  : array [1..255] of char;
  87.    end;
  88.  
  89.    GSP_IndexFile   = ^GSO_IndexFile;
  90.    GSP_InxNode = ^GSO_InxNode;
  91.  
  92.    GSP_InxTable = ^GSO_InxTable;
  93.    GSO_InxTable = Object(TCollection)
  94.       ixLink      : GSP_IndexFile;
  95.       ActivePage  : GSP_InxNode;
  96.       Elements    : array[0..NdxBlokSize div 12] of GSP_InxElement;
  97.       OkToClear   : boolean;
  98.       constructor Init(ILink : GSP_IndexFile);
  99.       destructor  Done; virtual;
  100.       function    AccessPage(pn : longint) : pointer;
  101.       procedure   AdjustNodePntrs(pn : longint);
  102.       function    FetchBttm : pointer;
  103.       function    FetchCurr : pointer;
  104.       function    FetchNext : pointer;
  105.       function    FetchPrev : pointer;
  106.       function    FetchTop  : pointer;
  107.       procedure   NodeEntryDelete(en : integer);
  108.       procedure   NodeEntryInsert(en : integer; wkey: string;
  109.                                   wb, wr: longint);
  110.       function    NodeGet(pn : longint) : pointer;
  111.       procedure   NodePntrReplace(en : integer; wkey: string; wb,wr: longint);
  112.       function    NodePut(pn : longint) : pointer;
  113.       procedure   ResetBuffers;
  114.    end;
  115.  
  116.    GSO_InxNode = Object(TObject)
  117.       tbLink      : GSP_InxTable;   {Link to collection owner}
  118.       IndxBufr    : GSP_InxDataBlk;
  119.       NodeLink    : Longint;
  120.       Page_No     : Longint;   {Disk block holding node info}
  121.       Etry_No     : Integer;   {Last entry used in node}
  122.       Count       : Integer;   {Number of keys in this node }
  123.       NonLeaf     : Boolean;   {True for non-leaf nodes}
  124.       Changed     : boolean;
  125.       constructor Init(CLink : GSP_InxTable; pn : longint);
  126.       destructor  Done; virtual;
  127.       procedure   Deliver;
  128.       procedure   Retrieve;
  129.    end;
  130.  
  131.    GSO_IndexFile   = object(GSO_DiskFile)
  132.       ixColl       : GSP_IndxColl;
  133.       ixKey_St     : ixKeyString;     {Holds last key value found}
  134.       ixKey_Num    : longint;         {Holds last physical record number}
  135.       IxKey_Form   : string[255];     {Holds the key formula in type string}
  136.       ixKey_Siz    : integer;
  137.       ixKey_Typ    : char;
  138.       ixBOF        : boolean;
  139.       ixEOF        : boolean;
  140.       ixFollowKey  : boolean;         {Flag to follow key for next read when}
  141.                                       {the key is modified.  If false, the }
  142.                                       {next record from the old key position }
  143.                                       {is read.  If true, the next record from}
  144.                                       {the new key position is read.  Default}
  145.                                       {is false}
  146.       tbLink       : GSP_InxTable;
  147.       Ndx_Hdr      : GSR_InxHeader;
  148.       Key_Lgth     : Integer;
  149.       Max_Keys     : Integer;
  150.       Entry_Sz     : Integer;
  151.       CurrNode     : GSP_InxNode;
  152.       CurrElmt     : GSP_InxElement;  {Pointer to key entry information}
  153.       CacheBuf     : PByteArray;
  154.       CacheBlok    : word;
  155.  
  156.       Constructor Init(IName : string);
  157.       Constructor NewInit(filname,formla: string; lth,dcl: integer; typ: char);
  158.       Destructor  Done; virtual;
  159.       Procedure   IndxClear; virtual;
  160.       Procedure   IndxStore(p : GSP_IndxColl; recnode : boolean); virtual;
  161.       Function    KeyFind(st : String) : longint; virtual;
  162.       Procedure   KeyList(st : string); virtual;
  163.       Function    KeyLocRec(rec : longint) : boolean; virtual;
  164.       Function    KeyRead(a : LongInt) : longint; virtual;
  165.       Procedure   KeySort(kl : integer; sa : SortStatus); virtual;
  166.       Procedure   KeyUpdate(rec: longint; st: string; Apnd: boolean); virtual;
  167.       Function    Ndx_AdjVal(st : string): string;
  168.       Procedure   Ndx_Close;
  169.       Procedure   Ndx_Flush;
  170.       Procedure   Ndx_GetHdr;
  171.       Function    Ndx_NextBlock : longint;
  172.       Procedure   Ndx_PutHdr;
  173.       Function    Ndx_Root : Longint;
  174.       Procedure   WriteStatus(RNum : longint); virtual;
  175.    end;
  176.  
  177. implementation
  178.  
  179.  
  180. const
  181.  
  182.    Same_Record = -5;   {Token value passed to read the same record}
  183.  
  184. var
  185.    Ndx_Data : GSR_InxDataBlk;
  186.  
  187.    Work_Key : string;               {Holds key passed in Find and KeyUpdate}
  188.    RPag     : Longint;              {Work variable to hold current index block}
  189.    RNum     : Longint;              {Work variable for record number}
  190.    IsAscend : Boolean;              {Flag for ascending/descending status.}
  191.                                     {Set based on Next/Previous Record read}
  192.  
  193. {------------------------------------------------------------------------------
  194.                                GSO_InxTable
  195. ------------------------------------------------------------------------------}
  196.  
  197. constructor GSO_InxTable.Init(ILink : GSP_IndexFile);
  198. var
  199.    p  : pointer;
  200.    i  : integer;
  201. begin
  202.    TCollection.Init(32,16);
  203.    for i := 0 to ILink^.Max_Keys do
  204.       Elements[i] := Addr(Ndx_Data.Data_Ary[Ndx_Data.Indx_Ary[i+1]]);
  205.    ixLink := ILink;
  206.    OkToClear := true;
  207. end;
  208.  
  209. destructor GSO_InxTable.Done;
  210. var
  211.    i : integer;
  212. begin
  213.    TCollection.Done;
  214. end;
  215.  
  216. function GSO_InxTable.AccessPage(pn : longint) : pointer;
  217. var
  218.    p  : GSP_InxNode;
  219.    px : longint;
  220.    i  : integer;
  221.    ok : boolean;
  222. begin
  223.    ok := false;
  224.    i := 0;
  225.    while (i < Count) and not ok do
  226.    begin
  227.       if GSP_InxNode(Items^[i])^.Page_No = pn then
  228.       begin
  229.          ok := true;
  230.          p := Items^[i];
  231.          AtDelete(i);
  232.          Insert(p);
  233.       end;
  234.       inc(i);
  235.    end;
  236.    if not ok then
  237.    begin
  238.       if Count > 7 then Free(Items^[0]);
  239.       p := New(GSP_InxNode, Init(@Self, pn));
  240.       Insert(p);
  241.    end;
  242.    ActivePage := p;
  243.    AccessPage := p;
  244. end;
  245.  
  246. procedure GSO_InxTable.AdjustNodePntrs(pn : longint);
  247. var
  248.    p : GSP_InxNode;
  249.    q : GSP_InxNode;
  250.    e  : GSP_InxElement;
  251.    i : integer;
  252.    v : integer;
  253.    x : longint;
  254. begin
  255.    p := AccessPage(pn);
  256.    if not p^.NonLeaf then exit;
  257.    for i := 0 to p^.Count-1 do
  258.    begin
  259.       e := Elements[i];
  260.       x := e^.Block_Ax;
  261.       for v := 0 to Count -1 do
  262.       begin
  263.          q := Items^[v];
  264.          if q^.Page_No = x then q^.NodeLink := pn;
  265.       end;
  266.    end;
  267. end;
  268.  
  269. function GSO_InxTable.FetchBttm : pointer;
  270. var
  271.    n  : longint;
  272.    p  : GSP_InxNode;
  273.    e  : GSP_InxElement;
  274. begin
  275.    p := NodeGet(ixLink^.Ndx_Root);
  276.    if p^.Count > 0 then e := Elements[p^.Count-1] else e := nil;
  277.    while p^.NonLeaf and (p^.Count > 0) do
  278.    begin
  279.       n := p^.Page_No;
  280.       p^.Etry_No := p^.Count;
  281.       if p^.Count > 0 then dec(p^.Etry_No);
  282.       p := NodeGet(e^.Block_Ax);
  283.       p^.NodeLink := n;
  284.       if p^.Count > 0 then e := Elements[p^.Count-1] else e := nil;
  285.    end;
  286.    p^.Etry_No := p^.Count;
  287.    if p^.Count > 0 then dec(p^.Etry_No);
  288.    FetchBttm := e;
  289. end;
  290.  
  291. function GSO_InxTable.FetchCurr : pointer;
  292. begin
  293.    FetchCurr := Elements[ActivePage^.Etry_No];
  294. end;
  295.  
  296. function GSO_InxTable.FetchNext : pointer;
  297. var
  298.    p  : GSP_InxNode;
  299.    h  : GSP_InxNode;
  300.    e  : GSP_InxElement;
  301.    n  : longint;
  302.    t  : boolean;
  303. begin
  304.    p := ActivePage;
  305.    p^.Retrieve;
  306.    h := p;
  307.    t := p^.NonLeaf;
  308.    inc(p^.Etry_No);
  309.    while (p^.Etry_No >= p^.Count) and (p^.NodeLink <> -1) do
  310.    begin
  311.       Delete(p);
  312.       AtInsert(0,p);
  313.       p := NodeGet(p^.NodeLink);
  314.       if t or (p^.Etry_No = p^.Count-1) then inc(p^.Etry_No);
  315.    end;
  316.    if (p^.Etry_No >= p^.Count) and (p^.Page_No = ixLink^.Ndx_Root) then
  317.       begin
  318.          FetchNext := nil;
  319.          dec(p^.Etry_No);
  320.       end
  321.          else if not t then
  322.                FetchNext := Elements[p^.Etry_No]
  323.             else
  324.             begin
  325.                e := Elements[p^.Etry_No];
  326.                while p^.NonLeaf do
  327.                begin
  328.                   n := p^.Page_No;
  329.                   p := NodeGet(e^.Block_Ax);
  330.                   p^.NodeLink := n;
  331.                   p^.Etry_No := 0;
  332.                   if p^. Count > 0 then e := Elements[0] else e := nil;
  333.                end;
  334.                FetchNext := e;
  335.             end;
  336. end;
  337.  
  338. function GSO_InxTable.FetchPrev : pointer;
  339. var
  340.    p  : GSP_InxNode;
  341.    h  : GSP_InxNode;
  342.    e  : GSP_InxElement;
  343.    n  : longint;
  344.    t  : boolean;
  345. begin
  346.    p := ActivePage;
  347.    p^.Retrieve;
  348.    h := p;
  349.    t := p^.NonLeaf;
  350.    if not t then dec(p^.Etry_No);
  351.    while (p^.Etry_No < 0) and (p^.NodeLink <> -1) do
  352.    begin
  353.       Delete(p);
  354.       AtInsert(0,p);
  355.       p := NodeGet(p^.NodeLink);
  356.       dec(p^.Etry_No);
  357.    end;
  358.    if (p^.Etry_No < 0) and (p^.Page_No = ixLink^.Ndx_Root) then
  359.    begin
  360.       FetchPrev := nil;
  361.       inc(p^.Etry_No);
  362.       while p^.NonLeaf do
  363.       begin
  364.          e := Elements[p^.Etry_No];
  365.          p := NodeGet(e^.Block_Ax);
  366.          inc(p^.Etry_No);
  367.       end;
  368.    end
  369.       else if not t then FetchPrev := Elements[p^.Etry_No]
  370.          else
  371.          begin
  372.             e := Elements[p^.Etry_No];
  373.             while p^.NonLeaf and (p^.Count > 0) do
  374.             begin
  375.                n := p^.Page_No;
  376.                p := NodeGet(e^.Block_Ax);
  377.                p^.NodeLink := n;
  378.                p^.Etry_No := p^.Count-1;
  379.                if p^. Count > 0 then e := Elements[p^.Count-1] else e := nil;
  380.             end;
  381.             FetchPrev := e;
  382.          end;
  383. end;
  384.  
  385. function GSO_InxTable.FetchTop : pointer;
  386. var
  387.    p  : GSP_InxNode;
  388.    e  : GSP_InxElement;
  389.    n  : longint;
  390. begin
  391.    p := NodeGet(ixLink^.Ndx_Root);
  392.    if p^.Count > 0 then e := Elements[0] else e := nil;
  393.    while p^.NonLeaf and (p^.Count > 0) do
  394.    begin
  395.       n := p^.Page_No;
  396.       p^.Etry_No := 0;
  397.       p := NodeGet(e^.Block_Ax);
  398.       p^.NodeLink := n;
  399.       if p^.Count <= 0 then e := nil;
  400.    end;
  401.    p^.Etry_No := 0;
  402.    FetchTop := e;
  403. end;
  404.  
  405. procedure GSO_InxTable.NodeEntryDelete(en : integer);
  406. var
  407.    p  : GSP_InxNode;
  408. begin
  409.    p := ActivePage;
  410.    Move(Elements[en+1]^,Elements[en]^,ixLink^.Entry_Sz*(p^.Count-en));
  411.    dec(Ndx_Data.Entry_Ct);
  412.    p^.Deliver;
  413. end;
  414.  
  415. procedure GSO_InxTable.NodeEntryInsert
  416.                                 (en : integer; wkey: string; wb,wr: longint);
  417. var
  418.    p  : GSP_InxNode;
  419.    e  : GSP_InxElement;
  420. begin
  421.    p := ActivePage;
  422.    e := Elements[en];
  423.    Move(Elements[en]^,Elements[en+1]^,ixLink^.Entry_Sz*(p^.Count-en));
  424.    move(wkey[1],e^.Char_Fld,ixLink^.Key_Lgth);
  425.    e^.Block_Ax := wb;
  426.    e^.Recrd_Ax := wr;
  427.    inc(Ndx_Data.Entry_Ct);
  428.    p^.Deliver;
  429. end;
  430.  
  431. function GSO_InxTable.NodeGet(pn : longint) : pointer;
  432. var
  433.    p  : GSP_InxNode;
  434. begin
  435.    p := AccessPage(pn);
  436.    p^.Retrieve;
  437.    NodeGet := p;
  438. end;
  439.  
  440. procedure GSO_InxTable.NodePntrReplace
  441.                                 (en : integer; wkey: string; wb,wr: longint);
  442. var
  443.    p  : GSP_InxNode;
  444.    q  : GSP_InxNode;
  445.    e  : GSP_InxElement;
  446. begin
  447.    p := ActivePage;
  448.    q := p;
  449.    p := NodeGet(p^.NodeLink);
  450.    while (p^.Etry_No >= p^.Count-1) and (p^.NodeLink <> -1) do
  451.       p := NodeGet(p^.NodeLink);
  452.    if p^.NodeLink <> -1 then
  453.    begin
  454.       e := Elements[p^.Etry_No];
  455.       FillChar(e^.Char_Fld, ixLink^.Key_Lgth, ' ');
  456.       move(wkey[1],e^.Char_Fld,length(wkey));
  457.       e^.Block_Ax := wb;
  458.       e^.Recrd_Ax := wr;
  459.       p^.Deliver;
  460.    end;
  461.    ActivePage := q;
  462.    ActivePage^.Retrieve;
  463. end;
  464.  
  465. function GSO_InxTable.NodePut(pn : longint) : pointer;
  466. var
  467.    p  : GSP_InxNode;
  468. begin
  469.    p := AccessPage(pn);
  470.    p^.Deliver;
  471.    NodePut := p;
  472. end;
  473.  
  474. procedure GSO_InxTable.ResetBuffers;
  475. begin
  476.    if OkToClear then FreeAll;
  477. end;
  478.  
  479. {------------------------------------------------------------------------------
  480.                                GSO_InxNode
  481. ------------------------------------------------------------------------------}
  482.  
  483. constructor GSO_InxNode.Init(CLink : GSP_InxTable; pn : longint);
  484. var
  485.    i : integer;
  486.    r : word;
  487. begin
  488.    IndxBufr := nil;
  489.    Page_No := pn;
  490.    Etry_No := -1;
  491.    Count := 0;
  492.    NonLeaf := true;
  493.    tbLink := CLink;
  494.    NodeLink := -1;
  495.    Changed := false;
  496. end;
  497.  
  498. destructor GSO_InxNode.Done;
  499. var
  500.    r : word;
  501. begin
  502.    if IndxBufr <> nil then dispose(IndxBufr);
  503.    TObject.Done;
  504. end;
  505.  
  506. procedure GSO_InxNode.Deliver;
  507. var
  508.    v : longint;
  509. begin
  510.    Count := Ndx_Data.Entry_Ct;
  511.    move(Ndx_Data.Data_Ary[(Count *  tbLink^.ixLink^.Entry_Sz)],v,4);
  512.    NonLeaf := v <> 0;
  513.    if NonLeaf then Count := Count + 1;
  514.    if IndxBufr = nil then New(IndxBufr);
  515.    move(Ndx_Data,IndxBufr^,NdxBlokSize);
  516.    tbLink^.ixLink^.Write(Page_No,IndxBufr^,NdxBlokSize);
  517. end;
  518.  
  519. procedure GSO_InxNode.Retrieve;
  520. var
  521.    v : longint;
  522. begin
  523.    if IndxBufr = nil then
  524.    begin
  525.       New(IndxBufr);
  526.       tbLink^.ixLink^.Read(Page_No,IndxBufr^,NdxBlokSize);
  527.    end;
  528.    move(IndxBufr^,Ndx_Data,NdxBlokSize);
  529.    Count := Ndx_Data.Entry_Ct;
  530.    move(Ndx_Data.Data_Ary[Ndx_Data.Indx_Ary[1]],v,4);
  531.    NonLeaf := v <> 0;
  532.    if nonLeaf then Count := Count + 1;
  533. end;
  534.  
  535. {-----------------------------------------------------------------------------
  536.                                  GSO_IndexFile
  537. ------------------------------------------------------------------------------}
  538.  
  539. constructor GSO_IndexFile.Init(IName : string);
  540. var
  541.    i : integer;
  542. begin
  543.    GSO_DiskFile.Init(IName+'.NTX',dfReadWrite+dfSharedDenyNone);
  544.    dfFileFlsh := WriteFlush;
  545.    if dfFileExst then Reset(1)
  546.       else
  547.       begin
  548.          Error(dosFileNotFound,ndxInitError);
  549.          exit;
  550.       end;
  551.    Read(0,Ndx_Hdr,NdxBlokSize);
  552.    Key_Lgth := Ndx_Hdr.Key_Lgth;
  553.    Max_Keys := Ndx_Hdr.Max_Keys;
  554.    Entry_Sz := Ndx_Hdr.Entry_Sz;
  555.    move(Ndx_Hdr.Key_Form[0], ixKey_Form[1],241);
  556.    ixKey_Form[0] := #241;
  557.    ixKey_Form[0] := chr(pos(#0,ixKey_Form)-1);
  558.    ixKey_Form := TrimR(ixKey_Form);
  559.    ixKey_Form := TrimL(ixKey_Form);
  560.    ixKey_Siz := Key_Lgth;
  561.    ixBOF := false;
  562.    ixEOF := false;
  563.    ixKey_St := '';
  564.    ixKey_Num := 0;
  565.    ixFollowKey := false;
  566.    Read(Ndx_Root,Ndx_Data,NdxBlokSize);
  567.    tbLink := New(GSP_InxTable, Init(@Self));
  568. end;
  569.  
  570. Constructor GSO_IndexFile.NewInit(filname,formla : string; lth,dcl: integer;
  571.                                   typ : char);
  572. var
  573.    i : integer;
  574. begin
  575.    GSO_DiskFile.Init(filname+'.NTX',dfReadWrite);
  576.    dfFileFlsh := WriteFlush;
  577.    Rewrite(1);
  578.    FillChar(Ndx_Hdr, SizeOf(Ndx_Hdr),#0);
  579.    Ndx_Hdr.Root := NdxBlokSize;
  580.    Ndx_Hdr.Vers1 := 6;
  581.    Ndx_Hdr.Vers2 := 1;
  582.    lth := lth+dcl;
  583.    if dcl > 0 then inc(lth);  {account for decimal point}
  584.    Ndx_Hdr.Key_Lgth := lth;
  585.    Ndx_Hdr.Key_Dcml := dcl;
  586.    i := lth+8;
  587.    Ndx_Hdr.Max_Keys := ((NdxBlokSize-4) div (i+2)) - 1;
  588.    if odd(Ndx_Hdr.Max_Keys) then dec(Ndx_Hdr.Max_Keys);
  589.    Ndx_Hdr.Min_Keys := Ndx_Hdr.Max_Keys div 2;
  590.    Ndx_Hdr.Entry_Sz := i;
  591.    CnvStrToAsc(formla,Ndx_Hdr.Key_Form, length(formla)+1);
  592.    Write(0,Ndx_Hdr,NdxBlokSize);
  593.    Key_Lgth := lth;
  594.    Max_Keys := Ndx_Hdr.Max_Keys;
  595.    Entry_Sz := Ndx_Hdr.Entry_Sz;
  596.    ixKey_Form := formla;
  597.    ixKey_Form := TrimR(ixKey_Form);
  598.    ixKey_Form := TrimL(ixKey_Form);
  599.    ixKey_Siz := Key_Lgth;
  600.    ixKey_Typ := typ;
  601.    ixBOF := false;
  602.    ixEOF := false;
  603.    ixKey_St := '';
  604.    ixKey_Num := 0;
  605.    ixFollowKey := false;
  606.    FillChar(Ndx_Data, SizeOf(Ndx_Data),#0);
  607.    for i := 0 to Ndx_Hdr.Max_Keys do Ndx_Data.Indx_Ary[succ(i)] :=
  608.                      ((Ndx_Hdr.Max_Keys + 2) * 2) + (Ndx_Hdr.Entry_Sz * i);
  609.    Write(-1,Ndx_Data,NdxBlokSize);
  610.    tbLink := New(GSP_InxTable, Init(@Self));
  611. end;
  612.  
  613. Destructor GSO_IndexFile.Done;
  614. var
  615.    i : integer;
  616. begin
  617.    Ndx_Close;
  618.    GSO_DiskFile.Done;
  619. end;
  620.  
  621. Procedure GSO_IndexFile.IndxClear;
  622. var
  623.    i : integer;
  624. begin
  625.    Ndx_Flush;
  626.    Ndx_GetHdr;
  627.    Ndx_Hdr.Root := 1;
  628.    Write(0,Ndx_Hdr,NdxBlokSize);
  629.    ixBOF := false;
  630.    ixEOF := false;
  631.    ixKey_St := '';
  632.    ixKey_Num := 0;
  633.    FillChar(Ndx_Data, SizeOf(Ndx_Data),#0);
  634.    Write(-1,Ndx_Data,NdxBlokSize);
  635.    Truncate(-1);
  636. end;
  637.  
  638. Procedure GSO_IndexFile.IndxStore(p: GSP_IndxColl; recnode: boolean);
  639. var
  640.    i         : integer;
  641.    rc        : integer;
  642.    rl        : word;
  643.    dt        : longint;
  644.    ec        : longint;
  645.    kc        : integer;
  646.    mh        : integer;
  647.    mk        : integer;
  648.    mm        : integer;
  649.    mr        : integer;
  650.    mv        : integer;
  651.    rf        : GSP_IndxEtry;
  652.    rr        : GSP_IndxEtry;
  653.    sc        : integer;
  654.    sv        : string[104];
  655.    dl        : integer;
  656.    ixFiller  : array[0..NdxBlokSize+108] of byte;
  657.    ixData    : GSR_InxDataBlk absolute ixFiller;
  658.    ixPntr    : GSP_InxElement;
  659.    ixBlok    : longint;
  660.    NodeColl  : GSP_IndxColl;
  661.  
  662.    procedure CacheWrite;
  663.    begin
  664.       move(ixData,CacheBuf^[CacheBlok],NdxBlokSize);
  665.       CacheBlok := CacheBlok+NdxBlokSize;
  666.       if CacheBlok >= NdxBlokSize*16 then
  667.       begin
  668.          Write(-1,CacheBuf^,CacheBlok);
  669.          CacheBlok := 0;
  670.       end;
  671.    end;
  672.  
  673.    procedure CollectNodes;
  674.    begin
  675.       ixData.Entry_Ct := rc-1;
  676.       CacheWrite;
  677.       if recnode then
  678.       begin
  679.          move(rr^.Tag,sv[Key_Lgth+1],4);  {Hang on to Record number}
  680.          sv[0] := chr(Key_Lgth+4);
  681.       end;
  682.       NodeColl^.InsertKey(ixBlok, sv);
  683.       rc := 0;
  684.       inc(ixBlok,NdxBlokSize);
  685.       mk := mv;
  686.       if mm > 0 then
  687.       begin
  688.          inc(mk);
  689.          dec(mm);
  690.       end;
  691.    end;
  692.  
  693. begin
  694.    mk := Max_Keys;
  695.    if recnode then mr := 1 else mr := 0;
  696.    kc := p^.KeyCount;
  697.    if kc <= mk then
  698.    begin
  699.       mk := kc+1;
  700.       mv := mk;
  701.       mm := 0;
  702.    end
  703.    else
  704.    begin
  705.       i := kc;
  706.       mv := 0;
  707.       repeat
  708.          mh := mv;
  709.          mv := i div mk;
  710.          inc(mv);
  711.          i := (kc - mv) + mr;
  712.       until mh = mv;
  713.       mm := i mod mv;
  714.       mk := i div mv;
  715.       inc(mk);               {to keep things balanced on leaf nodes}
  716.       mv := mk;
  717.       if mm > 0 then
  718.       begin
  719.          inc(mk);
  720.          dec(mm);
  721.       end;
  722.    end;
  723.    if recnode then
  724.    begin
  725.       ixBlok := NdxBlokSize;
  726.       GetMem(CacheBuf,NdxBlokSize*16);
  727.       Read(0,CacheBuf^,NdxBlokSize);    {Position to initial loc}
  728.    end
  729.    else
  730.    begin
  731.       ixBlok := Ndx_NextBlock;
  732.    end;
  733.    CacheBlok := 0;
  734.    New(NodeColl, Init(Key_Lgth+4,NoSort));
  735.    rr := p^.RetrieveKey;
  736.    rc := 0;
  737.    ec := 0;
  738.    FillChar(ixData, SizeOf(ixData),#0);
  739.    dl := (Max_Keys + 2) * 2;
  740.    for i := 0 to Max_Keys do ixData.Indx_Ary[i+1] := (dl + (Entry_Sz * i));
  741.    while rr <> nil do
  742.    begin
  743.       rf := rr;
  744.       ixPntr :=  Addr(ixData.Data_Ary[ixData.Indx_Ary[rc+1]]);
  745.       sv := rr^.KeyStr;
  746.       if (ixKey_Typ = 'N') and recnode then
  747.       begin
  748.          sv := PadL(sv, Key_Lgth);
  749.          for sc := 1 to length(sv) do
  750.               if sv[sc] = ' ' then sv[sc] := '0';
  751.       end;
  752.       move(sv[1],IxPntr^.Char_Fld[1],Key_Lgth);
  753.       if recnode then
  754.       begin
  755.          IxPntr^.Recrd_Ax := rr^.Tag;
  756.          IxPntr^.Block_Ax := 0;
  757.       end
  758.       else
  759.       begin
  760.          move(rr^.KeyStr[Key_Lgth+1],IxPntr^.Recrd_Ax,4); {Load Record number}
  761.          IxPntr^.Block_Ax := rr^.Tag;
  762.       end;
  763.       inc(rc);
  764.       inc(ec);
  765.       WriteStatus(ec);
  766.       if rc >= mk then CollectNodes;
  767.       rr := p^.RetrieveKey;
  768.    end;
  769.    if rc > 0 then
  770.    begin
  771.       rr := rf;
  772.       if recnode then inc(rc);
  773.       CollectNodes;
  774.    end;
  775.    p^.EndRetrieve;
  776.    if CacheBlok > 0 then Write(-1,CacheBuf^,CacheBlok);
  777.    if ec > Max_Keys then IndxStore(NodeColl, false);
  778.    Dispose(NodeColl, Done);
  779.    if recnode then
  780.    begin
  781.       FreeMem(CacheBuf,NdxBlokSize*16);
  782.       Dispose(ixColl, Done);
  783.       Ndx_Hdr.Root := Ndx_NextBlock-NdxBlokSize;
  784.       Ndx_Flush;
  785.    end;
  786. end;
  787.  
  788.  
  789. Function GSO_IndexFile.KeyFind(st : string) : LongInt;
  790. var
  791.    i         : integer;               {Work variable}
  792.    rl        : integer;               {Result code for Val procedure}
  793.    ct        : integer;               {Variable to hold BlockRead byte count}
  794.    IsEqual   : boolean;               {Flag to hunt for key match}
  795.    PNode     : longint;
  796.    Match_Cnd : integer;
  797.    LeafPag   : longint;
  798.    LeafEtry  : integer;
  799.  
  800.  
  801.    procedure StoreMatchValue;
  802.    begin
  803.       move(CurrElmt^.Char_Fld,ixKey_St[1],Key_Lgth);
  804.                                       {Move the key field to Ndx_Key_St.}
  805.       ixKey_St[0] := Work_Key[0];   {Now insert the length into Ndx_Key_St}
  806.    end;
  807.  
  808.    function DoMatchValue : integer;
  809.    begin
  810.       Match_Cnd := StrCompare(ixKey_St, Work_Key);
  811.       DoMatchValue := Match_Cnd;
  812.    end;
  813.  
  814.    function SearchMatchValue(var Index: Integer): Boolean;
  815.    var
  816.       L,
  817.       H,
  818.       I,
  819.       C: Integer;
  820.    begin
  821.       SearchMatchValue := False;
  822.       L := 0;
  823.       H := CurrNode^.Count - 1;
  824.       while L <= H do
  825.       begin
  826.          I := (L + H) shr 1;
  827.          CurrElmt := tbLink^.Elements[I];
  828.          if (CurrNode^.NonLeaf) and (CurrNode^.Count-1 = I) then
  829.             C := 1
  830.          else
  831.          begin
  832.             StoreMatchValue;
  833.             C := DoMatchValue;
  834.          end;
  835.          if C < 0 then L := I + 1 else
  836.          begin
  837.             H := I - 1;
  838.             if C = 0 then SearchMatchValue := true;
  839.          end;
  840.       end;
  841.       CurrElmt := tbLink^.Elements[L];
  842.       StoreMatchValue;
  843.       Index := L;
  844.    end;
  845.  
  846. begin
  847. {   tbLink^.ResetBuffers;}
  848.    ixKey_Num := 0;                    {Initialize}
  849.    ixKey_St := '';                    {Initialize}
  850.    Work_Key := Ndx_AdjVal(st);        {Set key comparison value}
  851.    RPag := Ndx_Root;                  {Get root node address}
  852.    PNode := -1;
  853.    ixEOF := true;
  854.    LeafPag := -1;
  855.    while RPag <> 0 do                 {While a non-leaf node, do this}
  856.    begin
  857.       CurrNode := tbLink^.NodeGet(RPag);
  858.       CurrNode^.NodeLink := PNode;
  859.       IsEqual := SearchMatchValue(i);
  860.       if IsEqual then
  861.       begin
  862.          LeafPag := RPag;
  863.          LeafEtry := i;
  864.       end;
  865.       CurrNode^.Etry_No := i;
  866.       ixEOF := ixEOF and (i >= Ndx_Data.Entry_Ct);
  867.       CurrElmt := tbLink^.Elements[i];
  868.       PNode := RPag;
  869.       RPag := CurrElmt^.Block_Ax;
  870.    end;
  871.    if IsEqual then
  872.       ixKey_Num := CurrElmt^.Recrd_Ax
  873.       else
  874.          if LeafPag > 0 then
  875.          begin
  876.             CurrNode := tbLink^.NodeGet(LeafPag);
  877.             CurrNode^.Etry_No := LeafEtry;
  878.             CurrElmt := tbLink^.Elements[LeafEtry];
  879.             ixKey_Num := CurrElmt^.Recrd_Ax
  880.          end
  881.          else
  882.             ixKey_Num := 0;
  883.    KeyFind := ixKey_Num;              {Return with the record number}
  884. end;
  885.  
  886. Procedure GSO_IndexFile.KeyList(st : string);
  887. var
  888.    ofil      : text;
  889.    RPag      : LongInt;
  890.    i,j,k,v   : integer;
  891.    rl        : integer;
  892.    ct        : integer;
  893.    recnode,
  894.    Less_Than : boolean;
  895.    WorkNode  : GSP_InxNode;
  896.    Next_Blk  : Longint;
  897. begin
  898.    Next_Blk := Ndx_NextBlock;
  899.    System.assign(ofil, st);
  900.    System.ReWrite(ofil);
  901.    writeln(ofil,'--------------------------------------------------');
  902.    writeln(ofil,'File Name = ',dfFileName);
  903.    writeln(ofil,'Key Expression = ',ixKey_Form);
  904.    writeln(ofil,'Key Length = ',Key_Lgth,
  905.                 '   Maximum Keys/Block = ',Max_Keys);
  906.    writeln(ofil,'Root =',Ndx_Root:5);
  907.    tbLink^.FreeAll;
  908.    WorkNode := tbLink^.FetchTop;
  909.    writeln(ofil,'Data records are at Level ',tbLink^.Count,
  910.                 ' in the hierarchy.');
  911.    RPag := NdxBlokSize;
  912.    while RPag <> Next_Blk do
  913.    begin
  914.       WorkNode := tbLink^.NodeGet(RPag);
  915.       System.write(ofil,RPag:2,'  [',Ndx_Data.Entry_Ct:2,']');
  916.       CurrElmt :=  tbLink^.Elements[0];
  917.       recnode := not WorkNode^.nonLeaf;
  918.       k := WorkNode^.Count;
  919.       v := 1;
  920.       i := 1;
  921.       while (i <= k) do
  922.       begin
  923.          CurrElmt :=  tbLink^.Elements[i-1];
  924.          with CurrElmt^ do
  925.          begin
  926.             System.write(ofil,'':v,Block_Ax:5);
  927.             v := 9;
  928.             if (i = k) and not recnode then System.write(ofil,'    0 - empty')
  929.             else
  930.                begin
  931.                   System.write(ofil,Recrd_Ax:5,' ');
  932.                   for j := 1 to Key_Lgth do
  933.                         System.write(ofil,Char_Fld[j]);
  934.                end;
  935.          WRITELN(OFIL);
  936.          end;
  937.          inc(i);
  938.       end;
  939.       writeln(ofil);
  940.       inc(RPag,NdxBlokSize);
  941.       tbLink^.FreeAll;
  942.    end;
  943.    Ndx_Flush;
  944.    System.Close(ofil);
  945. end;
  946.  
  947.  
  948. Function GSO_IndexFile.KeyLocRec (rec : longint) : boolean;
  949. var
  950.    lr : longint;
  951. begin
  952.    if rec = ixKey_Num then
  953.    begin                              {Exit if already at the record}
  954.       KeyLocRec := true;
  955.       exit;
  956.    end;
  957.    tbLink^.ResetBuffers;
  958.    lr := KeyRead(Top_Record);
  959.    while (not ixEOF) and (lr <> rec) do lr := KeyRead(Next_Record);
  960.    if (ixEOF) then KeyLocRec := false
  961.       else KeyLocRec := true;
  962. end;
  963.  
  964.  
  965. FUNCTION  GSO_IndexFile.KeyRead(a : longint) : longint;
  966. var
  967.    elem : GSP_InxElement;
  968.    h_str : ixKeyString;
  969.    h_num : longint;
  970. begin
  971.    RNum := a;
  972.    if ((a = Next_Record) or (a = Prev_Record)) and
  973.       (ixKey_Num = 0) then RNum := Top_Record;
  974.                                       {if first time through, use Top_Record}
  975.                                       {command instead}
  976.    if ((RNum = Next_Record) or (RNum = Prev_Record)) and (RNum = 0) then
  977.    begin
  978.       h_str := ixKey_St;
  979.       h_num := ixKey_Num;
  980.       ixKey_Num := KeyFind(h_str);
  981.       if ixKey_Num <> 0 then
  982.       begin
  983.          while (ixKey_Num < h_num) and (ixKey_St = h_str) do
  984.          begin
  985.             elem := tbLink^.FetchNext;
  986.             if elem <> nil then
  987.             begin
  988.                move(elem^.Char_Fld,ixKey_St[1],Key_Lgth);
  989.                ixKey_St[0] := chr(Key_Lgth);
  990.                ixKey_Num := elem^.Recrd_Ax;
  991.             end
  992.                else h_num := 0;
  993.          end;
  994.       end
  995.       else
  996.       begin
  997.          if ixEOF then
  998.          begin
  999.             elem := tbLink^.FetchPrev;
  1000.             if elem <> nil then
  1001.             begin
  1002.                move(elem^.Char_Fld,ixKey_St[1],Key_Lgth);
  1003.                ixKey_St[0] := chr(Key_Lgth);
  1004.                ixKey_Num := elem^.Recrd_Ax;
  1005.             end;
  1006.             ixEOF := false;
  1007.          end;
  1008.       end;
  1009.       if ixKey_Num <> h_num then RNum := Same_Record;
  1010.    end;
  1011.    ixBOF := false;
  1012.    ixEOF := false;                   {End-of-File initially set false}
  1013.    case RNum of                       {Select KeyRead Action}
  1014.  
  1015.       Next_Record : begin
  1016.                        elem := tbLink^.FetchNext;
  1017.                        if elem = nil then ixEOF := true;
  1018.                     end;
  1019.  
  1020.       Prev_Record : begin
  1021.                        elem := tbLink^.FetchPrev;
  1022.                        if elem = nil then ixBOF := true;
  1023.                     end;
  1024.  
  1025.       Top_Record  : begin
  1026.                        elem := tbLink^.FetchTop;
  1027.                        if elem = nil then ixEOF := true;
  1028.                     end;
  1029.  
  1030.  
  1031.       Bttm_Record : begin
  1032.                        elem := tbLink^.FetchBttm;
  1033.                        if elem = nil then ixBOF := true;
  1034.                     end;
  1035.  
  1036.       Same_Record : elem := tbLink^.FetchCurr;
  1037.  
  1038.       else          elem := nil;      {if no valid action, return zero}
  1039.    end;
  1040.    CurrNode := tbLink^.ActivePage;
  1041.    if elem <> nil then
  1042.    begin
  1043.       RNum := elem^.Recrd_Ax;
  1044.       move(elem^.Char_Fld,ixKey_St[1],Key_Lgth);
  1045.       ixKey_St[0] := chr(Key_Lgth);
  1046.       ixKey_Num := RNum;
  1047.       CurrElmt := elem;
  1048.    end
  1049.    else
  1050.    begin
  1051.       RNum := 0;
  1052.       CurrElmt := tbLink^.Elements[CurrNode^.Count];
  1053.    end;
  1054.    KeyRead := RNum;                   {Return RNum}
  1055. end;
  1056.  
  1057. Procedure GSO_IndexFile.KeySort(kl : integer; sa : SortStatus);
  1058. begin
  1059.    ixColl := New(GSP_IndxColl, Init(Key_Lgth, sa));
  1060. end;
  1061.  
  1062. Procedure GSO_IndexFile.KeyUpdate(rec : longint; st : string; Apnd : boolean);
  1063. var
  1064.    em_hold : boolean;                 {holds ExactMatch flag during this}
  1065.    old_key : ixKeyString;
  1066.    old_num : longint;
  1067.    shrrsl  : word;
  1068.  
  1069. {
  1070.    This routine deletes the current entry by overlaying the remaining entries
  1071.    over the entry location, and then decrementing the entry count
  1072. }
  1073.    Procedure DeleteEntry;
  1074.    begin
  1075.       tbLink^.NodeEntryDelete(CurrNode^.Etry_No);
  1076.    end;
  1077.  
  1078. {  This routine inserts an entry by making room in the current data array
  1079.    and inserting the new entry.  The entry count is then incremented.
  1080. }
  1081.    Procedure InsertEntry(var wk : ixKeyString; wb,wr : longint);
  1082.    begin
  1083.       tbLink^.NodeEntryInsert(CurrNode^.Etry_No,wk,wb,wr);
  1084.    end;
  1085.  
  1086. {  This routine searches back through the nodes to replace the key value in
  1087.    the non-leaf node.
  1088. }
  1089.    procedure ReplacePointerEntry(var wk : ixKeyString; wb,wr : longint);
  1090.    begin
  1091.       tbLink^.NodePntrReplace(CurrNode^.Etry_No,wk,wb,wr);
  1092.       CurrNode := tbLink^.ActivePage;
  1093.    end;
  1094.  
  1095. {  This routine is used to delete all references to a record key.  It will
  1096.    delete the key from the leaf node, and then search the non-leaf node and
  1097.    replace the pointer if it was the last entry in the non-leaf node.
  1098. }
  1099.    Procedure KeyDelete;
  1100.    var
  1101.       InLeaf : boolean;
  1102.       TheBlk : longint;
  1103.       TheStr : ixKeyString;
  1104.       TheRec : longint;
  1105.       DumRec : longint;
  1106.    begin
  1107.       InLeaf := not CurrNode^.NonLeaf;
  1108.       TheBlk := CurrElmt^.Block_Ax;
  1109.       if not InLeaf then
  1110.       begin
  1111.          TheRec := KeyRead(Prev_Record);
  1112.          move(CurrElmt^.Char_Fld,TheStr[1],Key_Lgth);
  1113.          TheStr[0] := chr(Key_Lgth);
  1114.          DumRec := KeyRead(Next_Record);
  1115.          ReplacePointerEntry(TheStr,TheBlk,TheRec);
  1116.          TheRec := KeyRead(Prev_Record);
  1117.       end;
  1118.       DeleteEntry;                    {delete the key from this node.}
  1119.       if (CurrNode^.Count = 0) and (CurrNode^.NodeLink <> -1) then
  1120.       begin                           {if empty, delete nonleaf pointer}
  1121.          CurrNode := tbLink^.NodeGet(CurrNode^.NodeLink);
  1122.          KeyDelete;
  1123.          exit;
  1124.       end;
  1125.       if inLeaf and (CurrNode^.Etry_No >= CurrNode^.Count) and
  1126.         (CurrNode^.NodeLink <> -1) then
  1127.       begin
  1128.          CurrElmt := tblink^.Elements[tbLink^.Count-1];
  1129.          move(CurrElmt^.Char_Fld,ixKey_St[1],Key_Lgth);
  1130.          ixKey_St[0] := chr(length(Work_Key));
  1131.          ReplacePointerEntry(ixKey_St,CurrElmt^.Block_Ax,CurrElmt^.Recrd_Ax);
  1132.       end;
  1133.    end;
  1134.  
  1135. {  This routine will divide a block into two equal blocks and then store the
  1136.    index levels (n1 and n2), entry counts (e1 and e2), and block numbers
  1137.    (b1 and b2) for later node pointer updates.  The new key (from the middle
  1138.    of the block's entries) will be saved in s1.
  1139. }
  1140.    Procedure SplitBlock(var p1,p2 : GSP_InxNode; var e : GSP_InxElement);
  1141.    var
  1142.       b1   : longint;
  1143.       e1   : integer;
  1144.       e2   : integer;
  1145.       en   : integer;
  1146.       wp   : longint;
  1147.  
  1148.    begin
  1149.       en := CurrNode^.Etry_No;
  1150.       wp := CurrNode^.Page_No;
  1151.       b1 := Ndx_NextBlock;                {Get the next available block.}
  1152.       e1 := (CurrNode^.Count) div 2;      {Number of entries in first half.}
  1153.       e2 := ((CurrNode^.Count) - e1);     {Number of entries in second half.}
  1154.       Ndx_Data.Entry_Ct := e1;
  1155.       dec(Ndx_Data.Entry_Ct);
  1156.       p1 := tbLink^.NodePut(b1);          {Save the block.}
  1157.       p1^.Etry_No := -1;
  1158.       p1^.NodeLink := CurrNode^.NodeLink;
  1159.       move(tbLink^.Elements[e1-1]^,e^,Entry_Sz);
  1160.       tbLink^.AdjustNodePntrs(b1);
  1161.       Ndx_Data.Entry_Ct := e2;
  1162.       if CurrNode^.NonLeaf then dec(Ndx_Data.Entry_Ct);
  1163.       move(tbLink^.Elements[e1]^,Ndx_Data.Data_Ary[Ndx_Data.Indx_Ary[1]],
  1164.            Entry_Sz*(e2+1));
  1165.                                           {Shift second half to beginning of}
  1166.                                           {the buffer array.}
  1167.       p2 := tbLink^.NodePut(wp);         {Save the block}
  1168.       p2^.Etry_No := -1;
  1169.       if en <= e1 then
  1170.       begin
  1171.          p1^.Etry_No := en;
  1172.          CurrNode := p1;
  1173.       end
  1174.       else
  1175.       begin
  1176.          p2^.Etry_No := en-e1;
  1177.          CurrNode := p2;
  1178.       end;
  1179.       Ndx_PutHdr;                  {Store from header info area}
  1180.       CurrNode := tbLink^.NodeGet(CurrNode^.Page_No);
  1181.       CurrElmt := tbLink^.Elements[CurrNode^.Etry_No];
  1182.    end;
  1183.  
  1184.  
  1185. {  This routine is used to create a new root node when the split block
  1186.    pointers will not fit in the current root node.
  1187. }
  1188.    Procedure MakeRootNode(wb,wr : longint);
  1189.    var i : integer;
  1190.    begin
  1191.       Ndx_Hdr.Root := Ndx_NextBlock;  {Set root pointer to this block.}
  1192.       Ndx_PutHdr;                     {Write updated header block.}
  1193.       FillChar(Ndx_Data, SizeOf(Ndx_Data),#0);
  1194.       for i := 0 to Ndx_Hdr.Max_Keys do Ndx_Data.Indx_Ary[succ(i)] :=
  1195.                     ((Ndx_Hdr.Max_Keys + 2) * 2) + (Ndx_Hdr.Entry_Sz * i);
  1196.       CurrElmt := tbLink^.Elements[0];
  1197.       CurrElmt^.Block_Ax := wb;
  1198.       CurrElmt^.Recrd_Ax := wr;
  1199.       CurrNode := tbLink^.NodePut(Ndx_Root);
  1200.       CurrNode^.Etry_No := 0;
  1201.    end;
  1202.  
  1203. {  This routine will split the current node, create a new root node if needed,
  1204.    and then insert the newly created block in the proper sequence in the node.
  1205. }
  1206.    procedure ExpandIndex;
  1207.    var
  1208.       e    : GSP_InxElement;
  1209.       p1   : GSP_InxNode;
  1210.       p2   : GSP_InxNode;
  1211.       pl   : longint;
  1212.       s    : ixKeyString;
  1213.    begin
  1214.       GetMem(e,Entry_Sz);
  1215.       SplitBlock(p1,p2,e);
  1216.       pl := CurrNode^.Page_No;
  1217.       if CurrNode^.NodeLink = -1 then
  1218.       begin
  1219.          MakeRootNode(p2^.Page_No,0);
  1220.          p1^.NodeLink := Ndx_Root;
  1221.          p2^.NodeLink := p1^.NodeLink;
  1222.       end
  1223.          else CurrNode := tbLink^.NodeGet(CurrNode^.NodeLink);
  1224.       if Ndx_Data.Entry_Ct >= Max_Keys then ExpandIndex;
  1225.       CurrElmt := tbLink^.Elements[p1^.Count-1];
  1226.       move(e^.Char_Fld,s[1],Key_Lgth);
  1227.       s[0] := chr(Key_Lgth);         {Save the last key entry in the block.}
  1228.       InsertEntry(s,p1^.Page_No,e^.Recrd_Ax);
  1229.       CurrNode := tbLink^.NodeGet(pl);
  1230.       CurrElmt := tBlink^.Elements[CurrNode^.Etry_No];
  1231.       FreeMem(e,Entry_Sz);
  1232.    end;
  1233.  
  1234. {  Routine to find the record that is just after the record key.  This is
  1235.    necessary to ensure a new duplicate key is properly inserted after any
  1236.    existing matching keys.
  1237. }
  1238.    Procedure FindLastKey;
  1239.    var
  1240.       nu_key : longint;
  1241.    begin
  1242.       nu_key := KeyFind(st);          {Find a matching key.}
  1243.       if nu_key <> 0 then             {If there is a match, continue looking}
  1244.       begin
  1245.          while (ixKey_St = Work_Key) and (not ixEOF) do
  1246.             nu_key := KeyRead(Next_Record);
  1247.          if CurrNode^.NonLeaf then nu_key := KeyRead(Prev_Record);
  1248.       end;
  1249.    end;
  1250.  
  1251. {  This routine will insert the new key into the index.  It will search for
  1252.    matching keys and insert the new key after any existing matches.  It will
  1253.    then check to see if the node is filled, and split the block if necessary.
  1254. }
  1255.    Procedure KeyInsert;
  1256.    begin
  1257.       FindLastKey;
  1258.       tbLink^.OkToClear := false;
  1259.       if Ndx_Data.Entry_Ct >= Max_Keys then  {overflow condition?}
  1260.       begin
  1261.          ExpandIndex;
  1262.          FindLastKey;
  1263.       end;
  1264.       if ixEOF then
  1265.       begin
  1266.          while CurrNode^.NonLeaf do
  1267.          begin
  1268.             CurrNode^.Etry_No := CurrNode^.Count-1;
  1269.             CurrElmt := tbLink^.Elements[CurrNode^.Etry_No];
  1270.             CurrNode := tbLink^.NodeGet(CurrElmt^.Block_Ax);
  1271.          end;
  1272.          CurrNode^.Etry_No := CurrNode^.Count;
  1273.       end;
  1274.       ixKey_St := PadR(Work_Key,Key_Lgth);
  1275.       ixKey_Num := rec;
  1276.       InsertEntry(ixKey_St,0,rec);
  1277.       if (CurrNode^.Etry_No = CurrNode^.Count-1) and
  1278.          (CurrNode^.Page_No <> Ndx_Root) then          {last entry in node?}
  1279.          ReplacePointerEntry(ixKey_St,CurrNode^.Page_No,0);
  1280.       tbLink^.OkToClear := true;
  1281.       if not ixFollowKey then
  1282.       begin
  1283.          ixKey_St := old_key;
  1284.          ixKey_Num := old_num;
  1285.       end;
  1286.       tbLink^.ResetBuffers;
  1287.    end;
  1288.  
  1289. begin
  1290.    old_key := ixKey_St;
  1291.    old_num := ixKey_Num;
  1292.    Work_Key := Ndx_AdjVal(st);        {Set key comparison value}
  1293.    if dfFileShrd then shrrsl := LockRec(0,NdxBlokSize);
  1294.    if not Apnd then                   {Tests for Append vs Update}
  1295.    begin
  1296.       if KeyLocRec(rec) then
  1297.       begin
  1298.          if Work_Key = ixKey_St then
  1299.          begin
  1300.             if dfFileShrd then
  1301.                shrrsl := UnLock;
  1302.             exit;
  1303.          end;
  1304.          KeyDelete;
  1305.       end;
  1306.    end;
  1307.    em_hold := dbExactMatch;
  1308.    dbExactMatch := true;
  1309.    KeyInsert;
  1310.    if dfFileShrd then shrrsl := UnLock;
  1311.    dbExactMatch := em_hold;
  1312. end;
  1313.  
  1314.  
  1315.  
  1316. function GSO_IndexFile.Ndx_AdjVal(st : string): string;
  1317. var
  1318.    Work_Key : string;
  1319.    dt       : longint;
  1320.    rl       : word;
  1321. begin
  1322.    if (ixKey_Typ = 'N') then
  1323.    begin
  1324.       Work_Key := PadL(st, Key_Lgth);
  1325.       for rl := 1 to length(Work_Key) do
  1326.               if Work_Key[rl] = ' ' then Work_Key[rl] := '0';
  1327.    end
  1328.    else Work_Key := st;
  1329.    Ndx_AdjVal := Work_Key;
  1330. end;
  1331.  
  1332. Procedure GSO_IndexFile.Ndx_Close;
  1333. begin
  1334.    Ndx_Flush;
  1335.    Dispose(tbLink, Done);
  1336.    Close;
  1337. end;
  1338.  
  1339. Procedure GSO_IndexFile.Ndx_Flush;
  1340. begin
  1341.    Ndx_PutHdr;
  1342.    tbLink^.FreeAll;
  1343.    ixKey_St := '';
  1344.    ixKey_Num := 0;
  1345. end;
  1346.  
  1347. Procedure GSO_IndexFile.Ndx_GetHdr;
  1348. begin
  1349.    Read(0,Ndx_Hdr,NdxBlokSize);
  1350. end;
  1351.  
  1352. Function GSO_IndexFile.Ndx_NextBlock : longint;
  1353. var
  1354.    rl : word;
  1355. begin
  1356.    Ndx_NextBlock := FileSize;
  1357. end;
  1358.  
  1359. Procedure GSO_IndexFile.Ndx_PutHdr;
  1360. begin
  1361.    Write(0,Ndx_Hdr,NdxBlokSize);
  1362. end;
  1363.  
  1364. Function GSO_IndexFile.Ndx_Root : Longint;
  1365. begin
  1366.    if dfFileShrd then Ndx_GetHdr;
  1367.    Ndx_Root := Ndx_Hdr.Root;
  1368. end;
  1369.  
  1370. Procedure GSO_IndexFile.WriteStatus(RNum : longint);
  1371. begin
  1372. end;
  1373.  
  1374. end.
  1375. {-----------------------------------------------------------------------------}
  1376.                                       END
  1377.  
  1378.  
  1379.